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//packmu pool. nib PoolMC.BR 

//bldr pool pool2 poolsetup poolcheck PoolPutPt PoolMC.BR ReadPram 

get "bcpl . head" 

//incoming procedures 

external [ LoadPackedRAM //from ReadPram 

Col //from Pool2 

Setup ; InitBall //from PoolSetup 



] 



CheckCol 1 isions //from PoolCheck 
Moveball;Abs //from PoolPutPt 



//outgoing statics- 
external [ XPos;YPos;XVel ; YVel ;Mass ; Radius ; R;Ball ;XPosold 
YPosold;Bal Is ;x;y 

3 

static [ XPos=nil // x position 

YPos=nil // y position 

XVel=nil // x velocity 

YVel=nil // y velocity 

Mass=l // ball mass 

Radius=5 // ball radius 

R=50 // coefficient of restitution times 64 

x=160 // x offset 

y=100 // y offset 

XPosold=nil // old x position 

YPosold=nil // old y position 

Ball=nil // bit pattern for ball 

Balls =15 // number of balls 
] 

//incoming statics 
external [ Screen 

Ramlmage 
] 

//internal statics 

static [ Balll;B.all2;Ball3;Ball4;Ball5;Ball6;Ball7;Ball8;Ball9;Balll0 

Ballll;BalU2;Balll3;Balll4;Balll5 //bit patterns pre-shifted 

BallSolect 

Del ayCount=50 

MinBal 1 sInMotion-5 
] 

1 et Start( ) be 

[ LoadPackedRAM(Ramlmage) 

let RamCall=table [ #61010 ;#1401] //JMPRAM; JMP 1,3 

let xp=vec(16) 

let yp=vec( 16) 

let xv=vec(16) 

1 et yv=vec( 16) 

let xo=vec(16) 

let yo=vec(16) 

let count=vec(16) ;Zero(count, 16) 

let ba'll=vec(16);Ball=ball 

Ball!0=table [ #370 ;#1406:^1002 ;#2001;#2001 ;#2001 ;#2001 ;#2001;#1002 ;#1406;#3 

**70] 
Ball !1 -table [ #3 70 ; #1406 ; #1002 ; #2141 ; #2041 ; #2041 ; #2041 ; #2161 ; #1002 ; #1406 ; #3 

**70] 
Ball ! 2= table [ #370 ; #1406 ; #1002 ; #2161 ; #2021 ; #2161 ; #2101 ; #2161 ; #1002 ; #1406 ; #3 

**70] 
Ball !3=table [ #370 ;#1406 ;#1002 ;#2161 ;#2021 ;#2161 ;#2021 ;#2161 ;#1002 ;#1406;#3 

**70] 
Ball !4=table [ #370 ;#1406 ;#1002 ;#2241 ;#2241 ;#2371 ;#2041 ;#2041 ;#1002 ;#1406 ;#3 

**70] 
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Ball!5=table [ #370;#1406;#1002 
Ball!6=table' [ #370;#1406 ;#1002 
Ball!7=table [ #370;#1406;#1002 
Ball!8=table [ #370;#1776;#1776 
Ball!9=table [ #370;#1406;#1002 
Ball !10=table [ #370;#1406;#1002 
Ball !ll=table [ #370 ;#1406;#1002 
Ball !12=table [ #370 ;#1406 ;#1002 
Ball !13=table [ #370 ;#1406 ;#1002 
Ball!14=table [ #370 ;#1406 ;#1002 
Ball!15=table [ #370 ;#1406;#1002 



#2 161; #2 101; #2161; #2021; #2 161; #1002; #1406; #3 

**70] 
#2161; #2 101; #2 161; #2121; #2 161; #1002; #1406; #3 

**70] 
; #2 161; #2021; #2021; #2021; #2021; #1002; #1406; #3 

**70] 
; #3617 ; #3657; #3617; #3657 ;#3617; #1776; #1776; #3 

**70] 
;#2 161; #2121; #2 161; #2021 ;#2021; #1002; #1406; #3 

**70] 
; #2271; #2251; #2251; #2251; #2271; #1002; #1406; #3 

**70] 
; #2121; #2121; #2121; #2121; #2 121; #1002; #1406; #3 

**70] 
; #2271; #2211; #2271; #2241; #2271; #10 02; #1406; #3 

**70] 
; #2271; #2211; #2271; #2211; #2271; #1002; #1406; #3 

**70] 
; #2251; #2251; #2271; #2211; #2211; #1002; #1406; #3 

**7Q] 
; #2271; #2241; #2271; #22 11; #2 271; #1002 ;#1406; #3 
**70] 



InitBal 
InitBal 
InitBal 
InitBal 
InitBal 
InitBal 
InitBal 
InitBal 
InitBal 
Ini tBal 
InitBal 
InitBal 
In i tBal 
InitBal 
InitBal 



lv 
Iv 
lv 
lv 
lv 
lv 
lv 
lv 
lv 
lv 
lv 
lv 
lv 
lv 
lv 



let bs 
Bal'ISe 
BallSe 
BallSe 
BallSe 
BallSe 
BallSe 
BallSe 
BallSe 
BallSe 
BallSe 
BallSe 
BallSe 
BallSe 
BallSe 
BallSe 
BallSe 
BallSe 



= vec 

1 ect = 

lect! 

lect! 

lect! 

lect! 

lect! 

lect! 

1 ect 

lect 

lect 

lect 

1 ect 

1 ect 

lect 

lect 

1 ect 

lect 



Balll,l) 

Ball2,2) 

Ball3,3) 

Ball4,4) 

Ball 5, 5) 

B a U 6 , 6 ) 

Bal 17,7) 

Ball8, 8) 

Ball9,9) 

Bal 110,10) 

Ballll.ll) 

BalU2,12) 

BalU3,13) 

BalU4,14) 

Ba'1115,15) 

16 

bs 

= B.a 1 1 1 5 

l=Bal!14 

2 = BalU3 

3 = Ba'IU2 
4=Ballll 
5=BalllO 
6=Ball9 

7 = B a 1 1 8 

8=Ball7 

9=Ball6 

10=Ba1 15 

1 1 - B a 1 1 4 

12=Ball3 

13=Ba112 

14=Ba111 

15=Ball 
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XPos=xp 

YPos=yp 

XVel=xv 

YVel=yv 

XPosold=xo 

YPosold=yo 

let mbs=nil 

let velflag=0 

let speed=0 

let vmax=0 

Setup(BallSelect) 

[ Wl("Push top button to place cue ball") 
let f rct= 1 

[ mbs=((not @#177030)&7) 

switchon mbs into // place cue ball 
[ default: loop 

case 4: let xl= (@#424-x)*64 
let yl= (@#425-y)*64 
Moveball(0,xl,yl) 
XPos!0=xl 
YPos!0=yl 
XPosold!0=xl 
YPosold!0=yl 
XVel! 0=0 
YVel !0=0 

] 
] repeatuntil mbs eq 4 

[ mbs=((not @#177030)&7) ] repeatuntil mbs eq 

Wl("Point arrow in direction of velocity") 

Wl("Push top button for high speed, middle for medium speed") 

Wl("and bottom for slow speed") 

[ mbs=((not @#177030)&7) 

if (mbs ne 0)&(XVel!0 eq 0)&(YVel!0 eq 0) then 

[ speed=selecton mbs into // determine velocity 
[ case 1: 128 
case 2: 64 
case 4: 256 

] 
let chx = (@#424)-(XPos!0 rslrift 6)-x 
let chy=(@#425)-(YPos!0 rshift 6)-y 
while (Abs(chx) gr 64)%(Abs(chy) gr 64) do 
[ chx=chx/2 
chy=chy/2 

] 

let sx = (chx gr 0-)?l,-l 
let sy=(chy gr 0)?1,-1 

test (Abs(chx) gr Abs(chy)) ifso // determine which has larger magni 

**tude 
[ XVel !0=speed*sx // chx has larger magnitude 

YVel !0=( speed* sx*chy)/chx 

ifnot // chy has larger magnitude 

[ YVel !0=speed*sy 

XVel !0=(speed*sy*chx)/chy 

3 



// get mouse coordinates 
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velf lag=0 

for n=0 to Balls do // begin loop to check each ball 

[if XPosln eq then loop // skip if ball isn't on table 
let XVelN=XVel In 
let YVelN=YVel !n 

if (XVelN eq 0) & (YVelN eq 0) then loop 
CheckXCushion : 

if (XPosln le 1728. & XVelN Is 0) % 

(XPosln ge 16448 & XVelN gr 0) then 

[ test (YPosln le -2304)%(YPos ! n ge 31168)% 
((YPosln ge 16256)&( YPos ! n le 17280)) ifso 
[ Moveball(n,XPosold!n,YPosold!n) 
XPos!.n = 0;YPos!n = 
loop 

] 

ifnot XVelN = -(XVelN) 

] 
CheckFriction : 

if fret eq then 

[ test Abs(XVelN) gr Abs(YVelN). ifso 
vmax=(Abs(XVe!N) rshift 5)+56 
ifnot vmax=(Abs(YVelN) rshift 5)+56 
if XVelN ne then XVelN=( vmax*(XVelN) )/66 
if YVelN ne then YVelN=(vmax*(YVelN))/66 
if (Abs(XVelN) le 1 )&(Abs(YVelN) le 1) then 
[ XVel !n=0 
YVel !n=0 
loop 
] 
] 
CheckYCushion : 

if (YPosln le 1728 & YVelN Is 0) % 

(YPosln ge 31872 & YVelN gr 0) then 

[ test (XPosln le 1900)%(XPos ! n ge 16200) ifso 
[ Moveball ( n , XPosol d ! n , YPosol d ! n) 
XPos!n=0;YPos!n=0 
loop 

] 
ifnot YVelN=-YVelN // bounce off cushion 

] 

velf lag=velf lag+1 

XVel !n=XVelN;YVel !n=YVelN 

CheckCol 1 is ions(n) 

if XVel In eq & YVel In eq then loop // if velocity = don't b 

' **other to change position 

CheckChange: 

let newposx = (XPos ! n)+(XVel ! n) // calculate new x position 
let newposy = ( YPos I n )+( YVel I n ) // calculate new y position 
if (newposx&#177700) ne ( (XPos I n )&#177700) % // if actual posi 

**tion changes moveball 
(newposy&#177700) ne ( ( YPos I n)&#177700) then 
[ Movebal 1 ( n , newposx, newposy) 
Moveball (n, XPosol din, YPosol d!n) 
XPosol d I n= newposx 
YPosold I n=newposy 

] 

XPos I n=newposx 
YPos ! n=newposy 
] //end of "for n=0 to Balls do" 
for i-velflag to Mi'nBal ls'InMotion .do 
for j=l to DelayCount do Idle() 
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fret = fret + 1 
if fret ge 30 then frct=0 
] repeatuntil (XPos!0 eq 0)&(ve1flag eq 0) 
] repeat 
] 
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get "bcpl.head" 

external [ XPos ; YPos ;XVel ;YVel ;Mass ;Radius ;R;Bal 1 ;Col ] 

let Col(n.m) be 

[ let Rshftnable [ #61010 ;#1401] 

let Vlxit,Vlyit,Vlxip,Vlyip,Vlxfp,Vlyfp = nil , ni 1 , ni 1 , ni 1 , ni 1 , ni 1 

let V2xit,V2yit,V2xip,V2yip,V2xfp,V2yfp=nil , ni 1 , ni 1 , nil , ni 1 , ni 1 

let sin=(YPos!n-YPos!m)/(Radius*2) 

let cos=(XPos!n-XPos!m)/(Radius*2) 

let Vlxi.Vlyi ,V2xi,V2yi=XVel !n, YVel !n, XVel !m, YVel !m 

let Vxc,Vxs,Vyc,Vys,Vxsc,Vysc=nil , nil, nil , nil , nil, nil 

Vxc=Rshft(Vlxi*cos,6) 

Vxs=Rshft(Vlxi*sin,6) 

Vyc=Rshft(Vlyi*cos,6) 

Vys=Rshft(Vlyi*sin,6) 

Vysc=Rshft(Vys*cos,6) 

Vxsc=Rshft(Vxs*cos,6) 

Vlxit=Rshft(Vxs*sin,6)-Vysc 

Vlyit=Rshft(Vyc*cos,6)-Vxsc 

Vlxip-Rshft(Vxc*cos,6)+Vysc 

Vlyip=Rshft(Vys*sin,6)+Vxsc 

Vxc=Rshft(V2xi*cos,6) 

Vxs=Rshft(V2xi*sin,6) 

Vyc=Rshft(V2yi*cos,6) 

Vys=Rshft(V2yi*sin,6) 

Vysc=Rshft(Vys*cos,6) 

Vxsc=Rshft(Vxs*cos,6) 

V2xit=Rshft(Vxs*sin,6)-Vysc 

V2yit=Rshft(Vyc*cos,6)-Vxsc 

V2x ip=Rshft(Vxc*cos,6)+Vysc 

V2yip=Rshft(Vys*sin,6)+Vxsc 

Vlxfp=Vlxip*Mass-Rshft(Vlxip*R,6)*Mass 

Vlxfp=Vlxfp+Rshft(V2xip*(R+64),6)*Mass 

Vlxfp=Vlxfp/(Mass+Mass) 

Vlyfp=Vlyip*Mass~Rshft(Vlyip*R,6) 

Vlyfp=Vlyfp+Rshft(V2yip*(R+64),6)*Mass 

Vlyfp=Vlyfp/(Mass+Mass) 

V2xfp=Rshf t(Vlxip*(R+64) ,6)*Mass 

V2xfp=V2xfp+V2x"ip*Mass-Rshft(V2xip*R,6)*Mass 

V2xfp=V2xfp/(Mass+Mass) 

V2yfp=Rshft(Vlyip*(R+64),6)*Mass 

V2yfp=V2yfp+V2yip*Mass-Rshft(V2yip*R,6)*Mass 

V2yfp=V2yfp/(Mass+Mass) 

let chx=XPos!n - XPosim 

let chy = YPos!n - YPos.'m 

let chvx=Vlxfp - V2xfp 

let chvy=Vlyfp - V2yfp 

if (chvx eq 0)&(chvy eq 0) then return 

if ((chx xor chvx) Is 0)&((chy xor chvy) Is 0) then return 

+ Vlxit 

+ Vlyit 

+ V2xit 

+ V2yit 



XVel 
YVel 
XVel 
YVel 



!n=Vlxfp 
!n=Vlyfp 
!m=V2xfp 
!m=V2yfp 



] 



//and Rshft(divisor, shifts) = 

// valof [ test divisor- gr ifso resultis divisor rshift shifts 

// ifnot resultis -1*( ( -l*di visor)rshif t shifts) 

// ] 
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//outgoing procedures 
external CheckCol 1 isions 

//incoming routines 
external Col 

//incoming statics 
external [ XPos ;XVel ; YPos ; YVel 
Balls 
] 

let CheckColl isions(n) be 
[ let RamCall=table [ #61010 ;#14Q1] 
//note for RamCall: n is FP!4 
let m=Bal Is 
[ m=RamCall(m,2) 

if m Is then return 

// let chy=YPos!n - YPoslm 

// let chx=XPos!n - XPoslm 

// let sx = (chx gr 0)?1,-1 

// let sy = (chy gn 0)71,-1 

// [ let chvx=XVel !n-XVel !m 

// let chvy=YVel !n-YVel !m 

// let svx=(chvx gr 0)71,-1 

// let svy=(chvy gr 0)71,-1 

// if (sx ne svx) % (sy ne svy) then Col(n.m) 

// ] 

Col(n.m) 
m=m-l 
] repeat 
] 
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;Microcode for Pool ball motion 

;SYMB0L DEFINITIONS FOR ALTO 

SMOUSE $L0, 14006, 100; 

$DISP$L0, 14007, 120; 

$MD$L26006, 14005, 124100; 

$DDR$L26010, 0,124100; 

SXPREG SL26010, 0,124000; 

$CSR SL26011, 0,124000; 

$TASK$L16002,0,0~; 

$BLOCK$L16003,0,0; 

SMARSL20001, 0,144000; 

$LLCY8$L0, 22006, 200 

$LRSH1$L0, 22005, 200 

$LLSH1$L0, 22004, 200 

$BUS=0$L24001,0,0; 

$SH<0$L24002,0,0; 

$SH=0$L24003,0,0; 

$BUS$L24004,0,0; 

$ALUCY$L24005,0,0; 

$IDISP$L24015,0,0; 

SBUSODD $L24010,0,0; 

$LMRSH1 $L0, 62005, 200 

$LMLSH1 $10,62004,200 

$EVENFIELD$L24010,0,0 

$SETMODE$L24011,0,0; 

$IR$L26014, 0,124000; 

$ACDEST$L3 0013,32013,60100; 

$DNS$L30012, 0,60000; 

$ACSOURCE$L0,32016,100; 

$L$L40001, 36001, 144200; 

$HALT$L42001,0,0; 

$BREAK$L42003,0,0; 

$WENB$L42005,0,0; 

$READY?$L42006,0,0; 

$NOVA$L44002, 46003, 124100; 

$ORT$L0,50002,2; 

$ANDT$LO,50003,2; 

$XORT$L0,50004,2; 

$+l$L0,50005,2; 

$-l$L0,50006,2; 

$+T$L0.50007,2; 

$-T$L0,50010,2; 

$-T-l$L0,50011,2; 

$+INCT$L0,50012,2; 

$+T+l$L0,50012,2; 

$+SKIP$L0,50013,2; 

$r$L52001, 54001, 124040; 

$END$L34000,0,0; 

$.T $10,50014,2; 

$AND NOT T$L0,50015,2; 



MAGIC RIGHT SHIFT 
MAGIC LEFT SHIFT 



SYNONYM FOR +T+1 
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;DEFINITIQNS FOR EMULATOR TASK 

SSTARTF $L16017,0,0; NDF1=17 

SRSNF $10,70016,100; NDF1=16 



DEFINITIONS FOR CONTROL RAM 
$SWMODE $L16010,0,0 
SWRTRAM $L16011,0,0; 
SRDRAM $L16012,0,0 

;DISK DEFINITIONS 
SKSTAT $L20012, 14003, 124100 
$RWC $L24011, .0, 0: 
SRECNO SL24012, 0, 
SINIT $L24010, 0, 
$CLRSTAT$L16014, 0, 
$KCOMM SL20015, 0, 124000; 
$SWRNRDY$L24014, 0, 0; 
SKADR SL20016, 0, 124000; 
SKDATA SL20017, 14004, 124100; 
SSTROBE SL16011, 0, 
$NFER $L24015, 0, 
$STROBON$L24016, 0, 0: 
SXFRDAT $L24013, 0, 
$INCRECNO$L16013, 0, 0; 
$SINK $L44000, 0, 124000; 



NDF1=10 
NDF1=11 
NDF1=12 



$NOP 



$L42000, 0, 0; 



(EMULATOR) 



DF1=12 (LHS) BS=3 (RHS) 

NDF2=11 

NDF2=12 

NDF2=10 

NDF1=14 

DF1=15 (LHS ONLY) REQUIRES BUS DEF 

NDF2=14 

DF1=16 (LHS ONLY) REQUIRES BUS DEF 

DF1=17 (LHS) BS=4 (RHS) 

NDF1=11 

NDF2=15 

NDF2=16 

NDF2=13 

NDF1=13 

DF3 = FAKE TO ALLOW BUS SOURCE WITH 

NO DESTINATION 

NDF3=0 ANOTHER FAKE 



;***xl4 change: added mesa subroutine return constants sr20-37, and -13D 

;***X13 CHANGE: REPLACED CONSTANT MEMORY WITH LISP VERSION 

| THE ALTO CONSTANT MEMORY 

; constants .mc - special for Lisp microcode 



last modified 28 mar 75 @ 13:40 



$0 

SAL 

$AL 

SMI 

SAL 

$M1 

$M7 

SX1 

SON 

$2 

$-2 

$3 

$4 



$L0 
LONES4 
LONES5 
7 $M6 
LONES7 
77770 

$M7 



,12000,100; CONSTANT IS SUPER-SPECIAL 

$M4: 177777; CONSTANT NORMALLY ANDED WITH KSTAT 

$M5': 177 777 ; CONSTANT NORMALLY ANDED WITH MD 

CONSTANT NORMALLY ANDED WITH MOUSE 

$M7: 177777; CONSTANT NORMALLY ANDED WITH DISP 

$M7:177770; MASK FOR DISP 

MASK FOR DISP 

MASK FOR DISP 

THE CONSTANT 1 



17 



:7; 
:17 



$-10 



$6 
$7 
$10 
5-1 
$17 
$20 
$37 
SALLONES 
$40 
$77 
$10 
$17 
$20 
$37 



$M7 

$1; 

$2; 

$177776; 

$3 

$4 

$5 

$6 

$7 

$10; 

$177770; 

$17 

$20 

$37 



- DISK HEADER WORD COUNT 



$177777 



DISK LABEL WORD COUN' 



THE REAL -1 (NOT A MASK) 



$40 
$77 
$10 
$17 
$20 
$37 
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$177400$177400; 




$-400 


$177400; 


$2000 


$2000; 


$PAGE1 


$400; 


$DASTART$420; 


$KBLKADR$521; 


$MOUSELOC$424; 


$CURLOC 


$426; 


$CLOCKLOC$430; 


$CON100 


$100; 


SCADM 


$7772; 


$SECTMSK$170000; 


$SECT2CM$40000; 


$-4 


$177774; 


$177766 


$177766; 


$177753 


$177753; 


$TOTUWC 


$44000; 


$TOWTT 


$66000; 


$STUWC 


$4000; 


$STRCWFS$10000; 


$177000 


$177000; 


$77777 


$77777; 


$77740 


$77740; 


$LOW14 


$177774; 


$77400 


$77400; 


$-67D 


$177675; 


$7400 


$7400; 


$7417 


$7417; 


$170360 


$170360; 


$60110 


$60110 




$30000 


$30000 




$70531 


$70531 




$20411 


$20411 




$65074 


$65074 




$41023 


$41023 





- DISK DATA WORD COUNT 



MAIN MEMORY DISPLAY HEADER ADDRESS 

MAIN MEMORY DISK BLOCK ADDRESS 

MAIN MEMORY MOUSE BLOCK ADDRESS 

MAIN MEMORY CURSOR BLOCK ADDRESS 



CYLINDER AND DISK MASK 

SECTOR MASK 

CAUSES ILLEGAL SECTORS TO CARRY OUT 

CURRENTLY UNUSED 

CURRENTLY UNUSED 

CURRENTLY UNUSED 

NO DATA TRANSFER 

NO DATA TRANSFER 



USE WRITE CLOCK 

DISABLE WORD TASK 
TRANSFER DATA USING WRITING CLOCK 
TRANSFER DATA USING NORMAL CLOCK, WAIT FOR SYNC 



$122645 $122645; 
$177034 $177034; 
$37400 $37400; 
$BIAS $177700; 
SWWLOC $452; 
$PCLOC $500; 
$100000 $100000; 
$177740 $177740; 
$C0MERR1 

$-7 $177771; 
$177760 $177760; 
$-3 $177775; 
$4560 $4560; 



CURSOR Y BIAS 
WAKEUP WAITING IN PAGE 
PC VECTOR IN PAGE 1 



$277; COMMAND ERROR MASK 
CURRENTLY UNUSED 



$56440 


$56440; 


$34104 


$34104; 


$64024 


$64024; 


$176000 


$176000 


$177040 


$177040 


$177042 


$177042 


$203 


$203; 


$360 


$360; 


$177600 


$177600 


$174000 


$174000 


$160000 


$160000 


$140000 


$140000 


$777 


$777; • 


$1777 


$1777; 


$3777 


$3777; 


$7777 


$77/7; 


$17777 


$17777; 



<KAHRS>P00LMC.MU;1 WED ll-MAY-77 5:33PM 



PAGE 1:3 



$37777 

$1000 

$20000 

$40000 

$-15D 



$37777; 

$1000; - 
$20000; 
$40000; 
$177761; 



STRAPDISP S526 
STRAPPC $527; 

$TRAPCON $470 

$JSRC $6000; JSR@ 

SMASKTAB $460 

$SH3CONST $14023 



MASK TABLE STARTING ADDRESS FOR CONVERT 
DESTIN-ATION»3, SKIP IF NONZERO CARRY, BASE CARRY = 



$EIPOSTLOC 

SEIIBIT $601; 

$EOPOSTLOC 

$EOIBIT 

$EIEOTLOC 

$EOEOTLOC 

$EOLOADLOC 

$EISERLOC 

$EIBCLOC 

$EOBCLOC 

$ITQUAN 
SITIBIT 

$402 $402; 

$M177760 
$JSRCX $4000; 
SKBLKADR2 
$KBLKADR3 

$MFRRDL $177757 
$MFR0BL $177744 
$MIRRDL $177774 
SMIROBL $177775 
SMRPAL $177775 
SMWPAL $177773 
$BDAD $12; 



$600 

$602 
$603 
$604 
$605 
$606 
$607 
$610 
$612 

$422 
$423 



ETHERNET CONSTANTS 



LOCATION INTO WHICH THE LABEL BLOCK WILL BE STORED ON BO 
**OT 
MASK FOR DISP. FOR I/O INSTRUCTIONS 



$M7:177760; 
JSR 
$523; 
$524; 



DISK HEADER READ DELAY IS 21 WORDS 

DISK HEADER PREAMBLE IS 34 WORDS 

DISK INTERRECORD READ DELAY IS 4 WORDS 

DISK INTERRECORD PREAMBLE IS 3 WORDS 

DISK READ POSTAMBLE LENGTH IS 3 WORDS 

DISK WRITE POSTAMBLE LENGTH IS 5 WORDS 
ON BOOT, DISK ADDRESS GOES IN LOC 12 



$REFMSK$77740; 

$X37$M7:37; NO.PAR MASK 

$M177740$M7:177740; DITTO 

$EIALOC$177701; LOCATION OF EIA INPUT HARDWARE 

; constants for Lisp microcode 



$7000 


$7000; 




map 


base 


$176 


$176; 




map 


nask 


$177576 


$177576 


; 




mapmask3 


$30 


$30; 




rep 


robinc 


$15 




$15; 




wrt-1 


$1770 




$1770; 




ciad 


$101771 




$101771 




ci low 


$175777 




$175777 




for resetting fbn 


$11 


$11 






jus 


t to have small integers 


$13 


$13 










$14 


$14 










$16 


$16 






for 


2CODE 


$60 


$60 






1 ow 


R to high R bus source 


$776 


$776; 








$177577 




$177577 




-129 


$100777 




$100777 




. 


$177677 




$177677 






$177714 






$177714 




(-2fvar+14) 



CONSTANTS ADDED BY LEO 
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$2527 

$101 

$630 

$631 

$642 

$lgml 

$lgm3 

SlgmlO 

$lgml4 

$lgm20 

$lgm40 

$lgmlOO 

$lgm200 



$2527; 

$101 

$630 

$631 

$642 

$M7:1; 

$M7:3; 

$M7:10 

$M7:14 

$M7:20 

$M7:40 

$M7:100 

$M7:200 



add new constants below this line only!!! 



$disp.300 

$-616 

$-650 

$22 

$24 

$-20 

$335 

$1377 

$401 

$2001 

$21 

$23 

$25 

$26 

$27 

$31 

$1675 

$736 

$-660 

$300 

$disp.377 

$6001 

$disp.3 



$M7:300; 



$177162; 

$177130; 

$22; 

$24; 

$177760; 

$335; 

$1377; 

$401; 

$2001; 

$21 

$23 

$25 

$26: 

$27: 

$31 

$1675; 

$736; 

$177120; 

$300; 

$6001; 
$M7:3; 



endcode for getframe 
smal 1 nzero 



just to have them 



$M7:377; 



f.e. 'fig, quick fig, use count 



. * * * y 1 

; some 

$srl 

$sr0 

$sr2 

$sr3 

$sr4 

$sr5 

$sr6 

$sr7 

$srl0 

$srll 

$sr!2 

$srl4 

$srl5 

$srl6 

$sr!7 



3 change declares the following constants for subroutine returns 
are added 



$60110 
$70531 
$61000 
$61400 
$62000 
$62400 
$67000 
$63400 
$64024 
$64400 
$65074 
$66000 
$66400 
$63000 
$77400 



added 

added 

added 

added 

added-value of 16b mapped to 6 by disp prom 

added 

added 



added 
added 
added- 



value of 6 mapped to 16b by disp prom 
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new constants sr20-sr37 use the srl3 IDISP slot to 'return' to a 
subroutine which does: SINK<-DISP,BUS ; retum20; 
added 23 oct 75. by CPT 



sr20 


$65400 




sr21 


$65401 




sr22 


$65402 




sr23 


$65403 




sr24 


$65404 




sr25 


$65405 




sr26 


$65406 




sr27 


$65407 




sr30 


$65410 




sr31 


$65411 




sr32 


$65412 




sr33 


$65413 




sr34 


$65414 




sr35 


$65415 




sr36 


$65416 




sr37 


$65417 




-13D 


$17776, 


3; 



X23 - August 11, 1976 



Alto II constants added for compatibility 
;177024 $177024 
;177025 $177025 
;177026 $177026 
17774 $7774; 



New stuff added for X21 - May 10, 1976 

Re-arranged to correspond to Alto II order - August 11, 1976 

12377 $2377; Added for changed Ethernet microcode 

12777 

13377 

1477 

1576 



$2777 
$3377 
$477; 
$576; 



Added for BitBlt 

Added for Ethernet boot 



$177175 $177175; 



;Dispatch definitions: 

!17,20,Moveball , In i t .CheckCol 1 is ions , In i t2 , Ini t3 , , Rshif t6 ; 
!20,1, START; return address for emulator restart 

REGISTERS USED BY NOVA EMULATOR 

$AC0 $R3; ac's'are backwards because the hardware supplies 

; the complement address when addressing from ir 

$R2 

$R1 

$R0 

$R4 

$R5 

$R6 

$R7 

$R40; not a real 
(in refresh task) 



S register, 
R11.R37 



but rather L gated to the bus 



$AC1 

$AC2 

$AC3 

$NWW 

$SAD 

$PC 

$XREG 

$LastL 

; Clock 

^Ethernet R12JU3 

;Display controller: R20-R30 

;Disk Controller: R31-R34 

; Avail able: R5.R10 .R14-17 .R35-36 



rett: TASK; most -general return (Re turn&TASK) 

retn: NOP; return, do nop first (prev inst has task) 

ret: SWMODE; 

:START; back .to ROM 
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Rsh if t6(num,6) arithmetic right shift 6 
! 1 , 2 ,pos6, neg6; 



Rshift6 


: L<-ACO; 
NOP,SH<0; 
T<-0 , :pos6; 




n e g 6 : 


T<-ONE; 




pos6: 


ACO<-L MR-SH 
L^ACO; 


1; 




ACO^L MRSH 


1; 




L<-ACO; 






ACO^-L MRSH 


1; 




L<-ACO; 






ACO<-L MRSH 


1; 




L^ACO; 






ACO<-L MRSH 


l; 




L<-ACO; 






ACO<-L MRSH 


1, :rett; 



Init(XPos,l,YPos) 



//initialize S registers for XPos , YPos , set MinDist=ll*64=7 
**04=#1300 



SXPos 
$YPos 
SMinDist 
SCollDist 



$R50 
$R51 
$R52 
$R53 



Init: T<-3; YPos at AC2!3 
MAR«-AC2+T; 
L^ACO; 
XPos^-L; 
L^MD; 
YPos<-L; 

T^lOO; 
L<-200+T; 
T<-1000; 

LH.astL+T.TASK;. 
MinDist*-L; . 

T<-200; CollDist=13*64=#l500 

L«-MinDist+T; 

CollDist«-L, :rett; 



Init2(XVel ,3,YVel) 



//and NWDS=18.=#22 



SXVel $R54; 

$YVel $R55; 

$NWDS $R45; words per scan line 

Init2: T«-3"; 

MAR«-AC2+T; 

L<-AC0; 

XVel<-L; 

L^MD; 

YVel*-L; 

T<-2; 
L<-20+T; 
NWDS«-L, :rett; 
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In it3( Ball Select, 4, Screen) 



SBallSelect 
SScreen $R57; 
$ninety $R74; 



SR56; 



Init3: T<-3 ; 

MAR^AC2+T; 

L<-AC0; 

BallSelect<-L; 

L<-MD; 

Screen«-L; 

;9Q.=#132 

T<-2; 

L<-10+T; 

T*-20; 

L«-LastL+T; 

T<-100; 

L<-LastL+T; 

ninety*-!., : rett; 



MoveBall (n.xa.ya) XOR's 11 or 22 words of ball pattern to screen 



for shift 
hift 

for shift 

counter for number of words to put out 
previous screen contents 
bits to XOR onto screen 
temp to store next ScreenAddr in 
per scan line 



$ya $R16; 

$xWord $R17; for s 

$ya4 $R36 

$count $R41 

$ScreenBits $R42 

$BallBits $R43 

$next $R44 

;$NWDS $R45; words 

$locat $R46 

$bits $R47 

SScreenAddr $R76 

$n $R75 

SBallVec $R73 



MoveBal 1 (n ,xa,ya) 

and Movebal 1 ( n , xa,ya) be 

[ let Rshift=table [ #61010 ;#1401] 

let xWord=Rshif t(xa,6) 

let "locat=18*Rshift(ya,6) + (xWord rshift 4) 

let bits=(xWord&#17)-ll 

if bits Is then [ locat = l ocat-1 ; bi ts = bi ts + 16] 

let BallVec=(BallSelect!bits) !n 

let Sc r een Add r=Screen+l+locat- 18*5 

let RamCall=table [ #61010 ;#1401] 

RamCal 1 (ScreenAddr ,0, Ball Bits) 

if bits Is 10 then RamCal 1 (ScreenAddr-1 , , Ball Bits+11) 
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(ya rshift 6)*16 



;n in ACQ, xa in AC3, ya in AC2+3 
Moveball: T<-3 ; 

MAR*-AC2+T; 

L<-AC0; 

n«-L; 

TOBIAS; BIAS=177700 

L<-MD AND T; 

ya*-L RS.H 1; 

L«-ya,TASK; 

ya4<-L RSH 1; 

L«-ya4,TASK; 

ya*-L RSH 1; 

L<-ya,TASK; 

ya+-L RSH 1; 

L<-ya,TASK; 

ya*-L RSH 1; (ya rshift 6)*2 

T*-ya4; 

L<-ya+T,TASK; 

ya<-L; //(ya rshift 6)*18 

; let xWord^xa rshift 6 

L*-AC3,TASK; 
AC3*-L RSH 1; 
L*-AC3,TASK; 
AC3«-L RSH 1; 
L«-AC3,T7\SK; 
AC3<-L RSH 1; 
L«-AC3,TASK; 
AC3<-L RSH 1 
L*-AC3,TASK; 
AC3<-L RSH 1 
L«-AC3,TASK; 
AC3<-L RSH 1; //xa rshift 6 

; let locat=18*Rshift(ya,6)+(xWord rshift 4) 



L«-AC3,TASK; 
xWord<-L RSH 1 
L<-xWord,TASK; 
xWord«-L RSH 1 
L«-xWord,TASK; 
xWord<-L RSH 1 
L<-xWord ; 
xWord<-L RSH 1 
T*-ya; 

L«-xWord+T,TASK; 
locat«-L; 



xWord rshift 4 



; let bits=(xWord&#17)-ll 
!l,2,bitsPositive,bitsNegative; 



T«-17; 

L*-AC3 AND T; 
T«-BDAD+1; 
L<-LastL-T; 
bits*-L,SH<0; 

if bits Is then [ locat= locat-1 ; bi ts=bi ts+16] 



L<-loeat-l, : bitsPositive ; 
bitsNegative: locat<~L; 
T<-20; 
L«-bits+T; 
bits«-L; 



***bitsPositive,bitsNegative 
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; let BallVec=(BallSelect!bits)!n 

bi tsPositive : T«-bits; 

MAR^BallSelect+T; 
T*-n ; 
L«-MD ; 

MAR<-LastL+T; 

NOP; 

L«-MD,TASK; 

BallVec<-L~; 

NOP; next instruction uses ALU«-SReg after TASK 

; let ScreenAddr=Screen+l+locat-18*5 //18*5=90=#132 

L<-Screen+1; 

T<-locat; 

L<-LastL+T; 

T<-ninety ; 

L^LastL-T.TASK; 

ScreenAddr<-L; 

! 1 , 2 , loop .break; 

L<-BDAD; BDAD=12 (10.) 
count*-L; 

L^BallVec; 
ACK-L; 

L<-ScreenAddr ; 
AC0«-L; 

loop: MAR<-T<-AC0; ScreenAddr 

L«-NWDS+T; 
next<-L ; 
L«-MD; 

MAR<-AC1; 
ScreenBi ts<-L; 
L<-AC1 + 1; 
AC1<~L; 
L<-MD,TASK; 
BallBits<-L; 

L*-next ; 

T«-ScreenBits ; 

MAR<-AC0; 

AC0*-L; 

L^BallBits. XOR T; 

MD<-LastL; 

L<-count-l; 

count*-L,SH<0; 

NOP,:loop; ***loop .break 
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; if bits Is 10 then RamCal 1 (ScreenAddr-1 , ,Bal IBi ts+11) 

!l,2,Onlyll,Do22; 

break: T*-BDAD; BDAD=#12=10. 
L<-bits-T; 
NOP,SH<0; 
NOP, :Onlyll; ***Onlyll,Do22; 

Onlyll: NOP,:rett; 

!1.2,loop2,breakZ; 

Do22: L<-T«-BDAD; BDAD = 12 (10.) 
count«-L; 

L*-Bal1Vec+T+l; //#12+1=#13=11 . 
AC1«-L; 

L«-ScreenAddr-l; 
AC0<-L; 

loop2: MAR«-T*-AC0; ScreenAddr 
L*-NWDS+T; 
next*-L; 
L<-MD; 

MAR«-AC1; 

ScreenBits*-L; 

L«-AC1 + 1; 

AC1«-L; 

L*-MD,TASK; 

BallBits<-L; 

L«-next ; 

T^-ScreenBits ; 

MAR<-AC0; 

AC0<-L; 

L«-BallBits XOR T; 

MD<-LastL; 

L«-count-l ; 

count^L,SH<0; 

NOP, : loop2; ***loop2 , break2 ; 

break2: NOP,:rett; 
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CheckCollisions(m,2) //m in AGO, n in AC214 



SXPo 

$YPo 

$chy 

Schx 

$m 

$sy 

$sx 

$dis 



sN 
sN 



$R60 
$R61 



SR14 
$R15 
$.R62 
$R64 
$R65 
$R66 



for Shift 
for Shift 



CheckCol 1 isions : ■ 

MAR<-L^AC2+T; 
L*-AC0; 

L<-T<-MD; 
n*-L; 

MAR«-XPos+T; 

L<-YPos+T; 

next<-L; 

L<-MD,TASK; 

XPosN<-L; 



MAR<-next; 
NOP; 
L<-MD; 
YPosN^L; 

for m=m to 15 do 

let chy=YPosN - YPoslm 
if Abs(chy) gr 11*64 then loop 
let chx=XPosN - XPos'.m 
if Abs(chx) gr 11*64 then loop 
if m eq n then loop 

l,2,MoreBalls.N.oMoreBalls; 
1 , 2,posl ,negl ; 
1 ,2,pos2,neg2; 
l,2,YSep,NoYSep; 
l,2,XSep,NoXSep; 
l,2,PossColl ision.NoCol ; 
l,2,CheckDir,NoColl ; 
l,2,CollY,NoCollY; - 
1,2,Co11X,NoCoI1X; 

T<-m; 
MoreBa'lls: MAR*-YPos+T; 
L<-0; 
sy<-L; 
T<-MD; 

L<-YPosN-T,TASK; 
chyH. ; 

L*-chy ; 

T*-ALLONES,SH<0; 
L«-chy XOR T, :posl; 
negl: chy<-L; 

L^IOOOOO; 
sy^L; • 



T*-4; offset of first param (n) 



//too much y separation, no collision 

//too much x separation, no collision 
//same ball 
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posl: T<-MinDist; 
L<-chy-Ti 
NOP,SH<0; • 

T>m,:YSep; ***Ysep , NoYSep -- go to YSep if Abs(chy) gr 11*64 (i.e 

**loop) 

NoYSep: MAR<-XPos+T; 
L<-0; 
sx«-L ; 
T<-MD; 

L«-XPosN-T,TASK; 
chx<-L; 

L<-chx; 

T^ALLONES,SH<0; 

L<-chx XOR T, :pos2; 
neg2: chx«-L; 

L«-100000; 

SX«-L; 
pos2: T«-MinDist; 

L<-chx-T; 

NOP,SH<0; 

T+-n,:XSep; go to XSep if Abs(chx) gr 11*64 (i.e., loop) 



NoXSep: L<-m-T; 



NOP,SH=0; 

NOP, :PossColl is ion; ***PossColl is ion, NoCol ; 



NoCollX: L«-m-l, :cont; 

NoCol 1 : L<-m-l , :cont; 

NoCol : L«-m-l, :cont; 

XSep : L*-m-l , : cont; 

YSep: L«-m-l; 

cont: m*-l_,SH<0; 

T<-m, :MoreBal Is; 
NoMoreBalls: AC0<-L, : rett; 

let dist = nil 

test Abs(chx) gr Abs(chy) ifso dist-Abs(chx) + (Abs(chy)) rshift 1 
ifnot dist = Abs(chy)'+ (Abs(chx)) rshift 1 
if dist le 13*64 then //collision 
[ let chvx=XVel !n-XVel !m 

let chvy=YVel !n-YVel !m 

let svx=(chvx gr ) ? 1 , - 1 

let svy=(chvy gr 0)?1,-1 

if (sx ne svx) % (sy ne svy) then Col(n.m) 

] 

!1.2,BigX,BigY; 
StempVel $R70; 
StempSign $R71; 

PossCol 1 ision : 

T<-chy; 

L<-chx-T; 

NOP.SIKO; 

N0P,:BigX; ***BigX,BigY 
BigX: L«-chy,TASK; 

dist<~L RSH 1; 

T«-dist; 

L<-chx+T; . 

dist<-L , -.HaveDist ; 
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BigY: 


L<-chx,TASK; 




dist<-L RSH 1; 




T«-dist; 




L*-chy+T; 




dist«-L; 


HaveDi 


st: T<-dist; 




L«-CollDist-T; 




NOP,SH<0; 




L«-m, :CheckDir; 


CheckD 


ir : 




T*-n; 




MAR«-YVel+T; 




NOP; 




L<-MD,TASK; 




tempVel<-L; 




T<-m; 




MAR<-YVel+T; 




NOP; 




T<-MD; 




L<-tempVel-T; 




T<-100000; 




L«-LastL AND T; 




T<-sy; 




L«-LastL-T; 




NOP,SH=0; 




NOP, :CollY; 


NoCollY: T<-n; ' 




MAR^-XVel+T; 




NOP; 




L<-MD,TASK; 




tempVel<-L; 




T<-m ; 




MAR*-XVe1+T; 




NOP; 




T«-MD; 




L<-tempVel -T; 




T<-100000; 




L^-LastL AND T; 




T<-sx; 




L<-LastL-T; 




NOP,SH=0; 




NOP, :CollX; 


CollY 


L«-m, :DoCol ; 


CollX 


L<-m, :DoCol ; 


DoCol 


AC0«-L, :rett; 



13*64-dist 

false if dist le 13*64 
***CheckDir,NoColl 



we only cane about the sign bit 



***CollY,NoCollY; 



***ConX,NoCollX: 
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: file PutPt.AS 



ACO 


= 


AC1 


= 1 


AC2 


= 2 


AC3 


= 3 


.ENT 


PutPt 


.ENT 


Abs 


.ENT 


ZeroPt 


.ENT 


UGr • 


.ENT 


UGe 


.ENT 


ULs 


.ENT 


ULe 


.ENT 


Movebal 1 



;set up for RamCall 



BEXT Screen 





.SREL 


PutPt: PUTPT 


Abs: ABSVAL 


ZeroPt: ZEROPT 


UGr 


UGR 


UGe 


UGE 


ULs 


ULS 


ULe 


ULE 


Movt 


sball : 



Movebal 1 



.NREL 

;Movebal 1 (n ,xa,.ya) 
.Movebal 1 : 

STA 3,My3 

MOV 1,3 

SUB 1,1 ;AC1 has RamCall number (0) 

61010 ;JMPRAM 

LDA 3,My3 

JMP 1,3 
My3: 

; Abs(x) 

; returns the absolute value of x 



ABSVAL: 



MOVL# ACO AC0,SZC ;negative ? 
NEG ACO ACO 
JMP 1.AC3 
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UGR: 



UGE 



ULS 



UGr(x,y) 

x and y are unsigned 16 bit numbers. 

UGr(x,y) returns true if x greater than y; otherwise, fals< 



SGTU 


ACO AC1 


SUB 


ACO ACO SKP 


ADC 


ACO ACO 


JMP 


! AC 3 



UGe(x.y) 

x and y are unsigned 16 bit numbers. 

UGe(x,y) returns true if x greater or equal than y; otherwise, false 



SGEU 


ACO AC1 




SUB 


ACO ACO 


SKP 


ADC 


ACO ACO 




JMP 


1 AC3 





ULs(x.y) 

x and y are unsigned 16 bit numbers. 

ULs(x,y) returns true if x less than y; otherwise, false 



SLTU 


ACO AC1 




SUB 


ACO ACO 


SKP 


ADC 


ACO ACO 




JMP 


1 AC3 





ULE 



ULe(x,y) 

x and y are unsigned 16 bit numbers. 

ULe(x,y) returns true if x "less or equal than y; otherwise, false 



SLEU 


ACO AC1 




SUB 


ACO ACO 


SKP 


ADC 


ACO ACO 




JMP 


1 AC3 
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ZEROPT: 



ZeroPt(x,yj 
clears appropriate point into "Screen 



STA 


AC3 


ret 


STA 


AC2 


savefp 


STA 


ACO 


X 


MOVZR ACO ACO 


MOVZR ACO ACO 


MOVZR ACO ACO 


MOVZR ACO ACO 


LDA 


AC2 


NWDS 


MUL 






MOVL# AC1 


AC1.SZC 


JMP 


return 


LDA 


ACO 


ScreenMax 


SGE 


ACO 


AC1 


JMP 


return 


STA 


AC1 


sword 


LDA 


ACO 


X 


LDA 


AC1 


C017 


AND 


AC1 


ACO 


SUB 


ACO 


AC1 


JSR 


BITTABLE 


ADD 


AC1 


AC3 


LDA 


ACO 


0.AC3 


LDA 


AC2 


0SCRN 


LDA 


AC1 


sword 


ADD 


AC1 


AC2' 


COM 


ACO 


AC3 


LDA 


AC1 


0,AC2 


AND 


AC3 


AC1 


STA 


AC1 


0.AC2 



x r s h i f t 4 

sword Is 0? 
yes ~ return 

sword gr ScreenMax? 
yes - return 

#17 
x & #17 
#17 - (x & #17) 

bittable!(#17 - (x & #17)) 

Screen 

iv (Screen ! sword) 

not bit 

Screen ! sword 

& not bit 

into Screenlsword 



JMP return 



PUTPT 



; PutPt(x.y) 

; stores appropriate point into Screen 



STA 


AC3 ret 


STA 


AC2 savefp 


STA 


ACO x 


MOVZR ACO ACO 


MOVZR ACO ACO 


MOVZR ACO ACO 


MOVZR ACO ACO 


LDA 


AC2 NWDS 


MUL 




MOVL# AC1 AC1.SZC 


JMP 


return 


LDA 


ACO ScreenMax 


SGE 


ACO AC1 


JMP 


return 


STA 


AC1 sword 


LDA 


ACO x 


LDA 


AC1 C017 


AND 


AC1 ACO 


SUB 


ACO AC1 


JSR 


BITTABLE 


ADD 


AC1 AC3 


LDA 


ACO 0.AC3 



x r s h i f t 4 



sword Is 0? 
yes - return 

sword gr ScreenMax? 
yes - return 



#17 
x & #17 
#17 - (x & #17) 



billable! (#17 - (x & #17)) 
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LDA 


AC2 


@SCRN 




LDA 


AC1 


sword 




ADD 


AC1 


AC 2 




COM 


ACO 


AC3 




LDA 


AC1 


0.AC2 




AND 


AC3 


AC1 




ADD 


ACO 


AC1 




STA 


AC1 


0.AC2 


return : 










LDA 


AC3 


ret 




LDA 


AC2 


savefp 




JMP 


1.AC3 


NWDS: 






18. 


ScreenMax: 




3468. 


C017: 




' 


17 



Screen 

Iv (Screen Isword) 

not bit 

Screen ! sword 

& not bit 

+ bit 

into Screenlsword 



;Words per scanline 
;18.*526. 



SCRN: 



Screen 



ret: 
x: 

sword : 
savefp : 



BITTABLE 



JSR 

1 

2 

4 

10 

20 

40 

100 

200 

400 

1000 

2000 

4000 

10000 

20000 

40000 

100000 



0.AC3 



return with address of table in AC3 



END 
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get "bcpl .head" 

//outgoing procedures 
external [ Setup; In itBal 1 ; PutLine 
] 

//incoming procedures 
external [ Moveball 

PutPt;Abs //from PutPt (assembly coded) 

] 

//outgoing statics 
external Screen 
static Screen 

//incoming statics 

external [ XPos ;XPosol d ; YPos ; YPosold ;XVel ; YVel 
x;y ;Bal ls;Ball . 
] 

//internal manifest and structure declarations 
manifest [ XLen=283 ; YLen=525 

WordsPerLine=18 //(283/16)=17 ; WordsPerLine must be even 

ScanLines=YLen+(YLen&l) //must be even 
] 

let InitBall(BallVeclv,numShifts) be 
[ let ballvec=GetFixed(15)-l 
for i=0 to 15 do 
[ let ballbits=GetFixed((numShifts gr 5)?21,10)-1 
bal 1 vec ! i=bal Ibits 

let balli=Ball!i //template of ith ball (11 word vector) 
for j = to 10 do ballbits! j = (ball i ! j) 1 shift numShifts 
if numShifts gr 5 then 

for j=ll to 21 do ballbits! j=(bal 1 i ! ( j-11) ) rshift ( 16-numShif ts) 

] 
@Ba I lVecl v = bal 1 vec 

] 

and Setup(BallSelect) be 

[ let RamCall=table [ #61010 ;#1401] 

let topDCB=GetFixed(5) 
topDCB=topDCB+(topDCB&l) //must be even 

Screen =GetFixed(WordsPerLine*ScanL i nes+5) 

let ScreenDCB=Screen+(Screen&l) //must be even 

Screen=ScreenDCB+4 

Zero(Screen,WordsPerLine*ScanLines) 

let bottomDCB=GetFixed(5) 

bottomDCB = bottomDCB+(bottomDCB8fl) //must be even 

topDCB!0=ScreenDCB 
topDCB!l=0 
topDCB!2=0 
topDCB!3=y/2 

ScreenDCB!0=bottomDCB 

ScreenDCB! l=WordsPerLine+((x/16) Ishift 8) 
ScreenDCB!2=Screen . ' 

ScreenDCB! 3 =ScanLines/2 
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bottomDCB !0=@#420 

bottomDCB! 1=0 

bottomDCB! 2=0 

bottomDCB! 3= (700- (Scan Li nes+y))/2 



RamCall(XPos,l,YPos) 
RamCall(XVel ,3,YVel) 
RamCall (Ball Select, 4, Screen) 

PutLine(0, 0,282,0) 
PutLine(282, 0,282, 524) 
PutLine(282, 524, 0,524) 
PutLine(0,524,0,0) 



//initialize S regs for XPos , YPos .MinDist 



// draw outer border of pool table 



// draw inner border of pool table 



// draw side pockets 



// draw corner pockets 



PutLine(20,20,262,20) 
PutLine(262,20,262,504) 
PutLine(262,504,20,504) 
PutLine(20,504,20,20) 



let pocket=254 

while pocket le 270 do 

[ PutLine(10, pocket, 20, pocket) 

Putl_ine( 262, pocket, 2 72, pocket) 

pocket=pocket+l 

] 
let lx=10 
let rx=21 
let incx=l 
let 1 i n e = 1 
let incy=l 

CnPckt( Ix, rx, 1 ine, incx, incy) 
lx=261 
rx=272 
incx=-l 

CnPckt(rx,lx,l ine, incx, incy) 
lx=261 
rx=272 
incy=-l 
1 ine=514 

CnPckt(rx, Ix, Tine, incx, incy) 
lx = 10 
rx = 21 
incx = l 

CnPckt( lx, rx, i ine, incx, incy) 

let ball=l // draw rack 

let xp=141*64 
let yp-383*64 
1 e t c 1 e n = 1 
let c n t r = 1 
let i n c = 6 4 
while clen le 5 do 

[ while (cntr le clen)&(ball le Balls) do 
[ Moveball (bal 1... xp ,yp) 

XPos!ball=xp 

XPosold!ball=xp 

YPos!ball=yp 

YPosold!ball=yp ■ 

XVel !ball=0 

YVel ! bal 1=0 

en tr = cntr + l 

ball=ball+l 

xp=xp+12*inc 

] 

yp=yp+704 

x p = x p - 6 * i n c 



] 
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inc=(-l)*inc 

clen-clen+1 

cntr=l 

] 

@#420=topDCB 



and CnPckt(xl,x2, line, incx, incy) be 
[ let 1 inemark=l ine+(ll*incy) 
while line ne linemark do 
[ PutLine(xl, line, x2, line) 
1 ine=l ine+incy 
x2=x2+incx 

] 

x2=x2-2*incx 

PutLine(xl,line,x2,line) 

1 ine=l ine+incy 

x2=x2-incx 

xl=xl+incx 

1 inernark = l ine+( 10*incy) 

while line ne linemark do 

[ PutLine(xl , 1 ine,x2, 1 ine) 

xl=xl+incx 

x2=x2-incx 

1 ine=l ine+incy 

] 
] 

and PutLine(xl ,yl ,x2,y2) be 
[ let hstep=xl-x2 
let vstep=yl-y2 
let hsign=(hstep ge 0)?1,-1 
let vsign=( vstep ge 0)?1,-1 
let absvstep=vsign*vstep 
let abshstep=hsign*hstep 
let count=0 
PutPt(xl.yl) 

until (Abs(xl-x2) le l)&(Abs(yl-y2) le 1) do 
[ PutPt(x2,y2) 

test count ge absvstep then //go horizontal 
[ x2=x2+hsign 

count=count-abs vstep 

] 

or 

[ y2=y2+vsign 

count=count+abshstep 

] 

] 
PutPt(x2,y2) 

] 



